home *** CD-ROM | disk | FTP | other *** search
/ Aminet 1 (Walnut Creek) / Aminet - June 1993 [Walnut Creek].iso / aminet / util / gnu / emacs_src_18_58.lha / emacs-18.58 / src / cmds.c < prev    next >
C/C++ Source or Header  |  1992-04-26  |  9KB  |  346 lines
  1. /* Simple built-in editing commands.
  2.    Copyright (C) 1985, 1990 Free Software Foundation, Inc.
  3.  
  4. This file is part of GNU Emacs.
  5.  
  6. GNU Emacs is free software; you can redistribute it and/or modify
  7. it under the terms of the GNU General Public License as published by
  8. the Free Software Foundation; either version 1, or (at your option)
  9. any later version.
  10.  
  11. GNU Emacs is distributed in the hope that it will be useful,
  12. but WITHOUT ANY WARRANTY; without even the implied warranty of
  13. MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  14. GNU General Public License for more details.
  15.  
  16. You should have received a copy of the GNU General Public License
  17. along with GNU Emacs; see the file COPYING.  If not, write to
  18. the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.  */
  19.  
  20.  
  21. #include "config.h"
  22. #include "lisp.h"
  23. #include "commands.h"
  24. #include "buffer.h"
  25. #include "syntax.h"
  26.  
  27. Lisp_Object Qkill_forward_chars, Qkill_backward_chars, Vblink_paren_hook;
  28.  
  29.  
  30. DEFUN ("forward-char", Fforward_char, Sforward_char, 0, 1, "p",
  31.   "Move point right ARG characters (left if ARG negative).\n\
  32. On reaching end of buffer, stop and signal error.")
  33.   (n)
  34.      Lisp_Object n;
  35. {
  36.   if (NULL (n))
  37.     XFASTINT (n) = 1;
  38.   else
  39.     CHECK_NUMBER (n, 0);
  40.  
  41.   SET_PT (point + XINT (n));
  42.   if (point < BEGV)
  43.     {
  44.       SET_PT (BEGV);
  45.       Fsignal (Qbeginning_of_buffer, Qnil);
  46.     }
  47.   if (point > ZV)
  48.     {
  49.       SET_PT (ZV);
  50.       Fsignal (Qend_of_buffer, Qnil);
  51.     }
  52.   return Qnil;
  53. }
  54.  
  55. DEFUN ("backward-char", Fbackward_char, Sbackward_char, 0, 1, "p",
  56.   "Move point left ARG characters (right if ARG negative).\n\
  57. On attempt to pass beginning or end of buffer, stop and signal error.")
  58.   (n)
  59.      Lisp_Object n;
  60. {
  61.   if (NULL (n))
  62.     XFASTINT (n) = 1;
  63.   else
  64.     CHECK_NUMBER (n, 0);
  65.  
  66.   XSETINT (n, - XINT (n));
  67.   return Fforward_char (n);
  68. }
  69.  
  70. DEFUN ("forward-line", Fforward_line, Sforward_line, 0, 1, "p",
  71.   "If point is on line i, move to the start of line i + ARG.\n\
  72. If there isn't room, go as far as possible (no error).\n\
  73. Returns the count of lines left to move.\n\
  74. With positive ARG, a non-empty line traversed at end of buffer \n\
  75.  counts as one line successfully moved (for the return value).")
  76.   (n)
  77.      Lisp_Object n;
  78. {
  79.   int pos2 = point;
  80.   int pos;
  81.   int count, shortage, negp;
  82.  
  83.   if (NULL (n))
  84.     count = 1;
  85.   else
  86.     {
  87.       CHECK_NUMBER (n, 0);
  88.       count = XINT (n);
  89.     }
  90.  
  91.   negp = count <= 0;
  92.   pos = scan_buffer ('\n', pos2, count - negp, &shortage);
  93.   if (shortage > 0
  94.       && (negp
  95.       || (ZV > BEGV && pos != pos2
  96.           && FETCH_CHAR (pos - 1) != '\n')))
  97.     shortage--;
  98.   SET_PT (pos);
  99.   return make_number (negp ? - shortage : shortage);
  100. }
  101.  
  102. DEFUN ("beginning-of-line", Fbeginning_of_line, Sbeginning_of_line,
  103.   0, 1, "p",
  104.   "Move point to beginning of current line.\n\
  105. With argument ARG not nil or 1, move forward ARG - 1 lines first.\n\
  106. If scan reaches end of buffer, stop there without error.")
  107.   (n)
  108.      Lisp_Object n;
  109. {
  110.   if (NULL (n))
  111.     XFASTINT (n) = 1;
  112.   else
  113.     CHECK_NUMBER (n, 0);
  114.  
  115.   Fforward_line (make_number (XINT (n) - 1));
  116.   return Qnil;
  117. }
  118.  
  119. DEFUN ("end-of-line", Fend_of_line, Send_of_line,
  120.   0, 1, "p",
  121.   "Move point to end of current line.\n\
  122. With argument ARG not nil or 1, move forward ARG - 1 lines first.\n\
  123. If scan reaches end of buffer, stop there without error.")
  124.   (n)
  125.      Lisp_Object n;
  126. {
  127.   register int pos;
  128.   register int stop;
  129.  
  130.   if (NULL (n))
  131.     XFASTINT (n) = 1;
  132.   else
  133.     CHECK_NUMBER (n, 0);
  134.  
  135.   if (XINT (n) != 1)
  136.     Fforward_line (make_number (XINT (n) - 1));
  137.  
  138.   pos = point;
  139.   stop = ZV;
  140.   while (pos < stop && FETCH_CHAR (pos) != '\n') pos++;
  141.   SET_PT (pos);
  142.  
  143.   return Qnil;
  144. }
  145.  
  146. DEFUN ("delete-char", Fdelete_char, Sdelete_char, 1, 2, "p\nP",
  147.   "Delete the following ARG characters (previous, with negative arg).\n\
  148. Optional second arg KILLFLAG non-nil means kill instead (save in kill ring).\n\
  149. Interactively, ARG is the prefix arg, and KILLFLAG is set if\n\
  150. ARG was explicitly specified.")
  151.   (n, killflag)
  152.      Lisp_Object n, killflag;
  153. {
  154.   CHECK_NUMBER (n, 0);
  155.  
  156.   if (NULL (killflag))
  157.     {
  158.       if (XINT (n) < 0)
  159.     {
  160.       if (point + XINT (n) < BEGV)
  161.         Fsignal (Qbeginning_of_buffer, Qnil);
  162.       else
  163.         del_range (point + XINT (n), point);
  164.     }
  165.       else
  166.     {
  167.       if (point + XINT (n) > ZV)
  168.         Fsignal (Qend_of_buffer, Qnil);
  169.       else
  170.         del_range (point, point + XINT (n));
  171.     }
  172.     }
  173.   else
  174.     {
  175.       call1 (Qkill_forward_chars, n);
  176.     }
  177.   return Qnil;
  178. }
  179.  
  180. DEFUN ("delete-backward-char", Fdelete_backward_char, Sdelete_backward_char,
  181.   1, 2, "p\nP",
  182.   "Delete the previous ARG characters (following, with negative ARG).\n\
  183. Optional second arg KILLFLAG non-nil means kill instead (save in kill ring).\n\
  184. Interactively, ARG is the prefix arg, and KILLFLAG is set if\n\
  185. ARG was explicitly specified.")
  186.   (n, killflag)
  187.      Lisp_Object n, killflag;
  188. {
  189.   CHECK_NUMBER (n, 0);
  190.   return Fdelete_char (make_number (-XINT (n)), killflag);
  191. }
  192.  
  193. DEFUN ("self-insert-command", Fself_insert_command, Sself_insert_command, 1, 1, "p",
  194.   "Insert this character.  Prefix arg is repeat-count.")
  195.   (arg)
  196.      Lisp_Object arg;
  197. {
  198.   CHECK_NUMBER (arg, 0);
  199.  
  200.   while (XINT (arg) > 0)
  201.     {
  202.       XFASTINT (arg)--;        /* Ok since old and new vals both nonneg */
  203.       self_insert_internal (last_command_char, XFASTINT (arg) != 0);
  204.     }
  205.   return Qnil;
  206. }
  207.  
  208. DEFUN ("newline", Fnewline, Snewline, 0, 1, "P",
  209.   "Insert a newline.  With arg, insert that many newlines.\n\
  210. In Auto Fill mode, can break the preceding line if no numeric arg.")
  211.   (arg1)
  212.      Lisp_Object arg1;
  213. {
  214.   int flag;
  215.   Lisp_Object arg;
  216.   char c1 = '\n';
  217.  
  218.   arg = Fprefix_numeric_value (arg1);
  219.  
  220.   if (!NULL (current_buffer->read_only))
  221.     Fsignal (Qbuffer_read_only, Qnil);
  222.  
  223.   /* Inserting a newline at the end of a line
  224.      produces better redisplay in try_window_id
  225.      than inserting at the ebginning fo a line,
  226.      And the textual result is the same.
  227.      So if at beginning, pretend to be at the end.
  228.      Must avoid self_insert_internal in that case since point is wrong.
  229.      Luckily self_insert_internal's special features all do nothing in that case.  */
  230.  
  231.   flag = point > BEGV && FETCH_CHAR (point - 1) == '\n';
  232.   if (flag)
  233.     SET_PT (point - 1);
  234.  
  235.   while (XINT (arg) > 0)
  236.     {
  237.       if (flag)
  238.     insert (&c1, 1);
  239.       else
  240.     self_insert_internal ('\n', !NULL (arg1));
  241.       XFASTINT (arg)--;        /* Ok since old and new vals both nonneg */
  242.     }
  243.  
  244.   if (flag)
  245.     SET_PT (point + 1);
  246.  
  247.   return Qnil;
  248. }
  249.  
  250. self_insert_internal (c1, noautofill)
  251.      char c1;
  252.      int noautofill;
  253. {
  254.   extern Lisp_Object Fexpand_abbrev ();
  255.   int hairy = 0;
  256.   Lisp_Object tem;
  257.   register enum syntaxcode synt;
  258.   register int c = c1;
  259.  
  260.   if (!NULL (current_buffer->overwrite_mode)
  261.       && point < ZV
  262.       && c != '\n' && FETCH_CHAR (point) != '\n'
  263.       && (FETCH_CHAR (point) != '\t'
  264.       || XINT (current_buffer->tab_width) <= 0
  265.       || !((current_column () + 1) % XFASTINT (current_buffer->tab_width))))
  266.     {
  267.       del_range (point, point + 1);
  268.       hairy = 1;
  269.     }
  270.   if (!NULL (current_buffer->abbrev_mode)
  271.       && SYNTAX (c) != Sword
  272.       && NULL (current_buffer->read_only)
  273.       && point > BEGV && SYNTAX (FETCH_CHAR (point - 1)) == Sword)
  274.     {
  275.       tem = Fexpand_abbrev ();
  276.       if (!NULL (tem))
  277.     hairy = 1;
  278.     }
  279.   if ((c == ' ' || c == '\n')
  280.       && !noautofill
  281.       && !NULL (current_buffer->auto_fill_hook)
  282.       && current_column () > XFASTINT (current_buffer->fill_column))
  283.     {
  284.       if (c1 != '\n')
  285.     insert (&c1, 1);
  286.       call0 (current_buffer->auto_fill_hook);
  287.       if (c1 == '\n')
  288.     insert (&c1, 1);
  289.       hairy = 1;
  290.     }
  291.   else
  292.     insert (&c1, 1);
  293.   synt = SYNTAX (c);
  294.   if ((synt == Sclose || synt == Smath)
  295.       && !NULL (Vblink_paren_hook) && FROM_KBD)
  296.     {
  297.       call0 (Vblink_paren_hook);
  298.       hairy = 1;
  299.     }
  300.   return hairy;
  301. }
  302.  
  303. /* module initialization */
  304.  
  305. syms_of_cmds ()
  306. {
  307.   Qkill_backward_chars = intern ("kill-backward-chars");
  308.   staticpro (&Qkill_backward_chars);
  309.  
  310.   Qkill_forward_chars = intern ("kill-forward-chars");
  311.   staticpro (&Qkill_forward_chars);
  312.  
  313.   DEFVAR_LISP ("blink-paren-hook", &Vblink_paren_hook,
  314.     "Function called, if non-nil, whenever a char with closeparen syntax is self-inserted.");
  315.   Vblink_paren_hook = Qnil;
  316.  
  317.   defsubr (&Sforward_char);
  318.   defsubr (&Sbackward_char);
  319.   defsubr (&Sforward_line);
  320.   defsubr (&Sbeginning_of_line);
  321.   defsubr (&Send_of_line);
  322.  
  323.   defsubr (&Sdelete_char);
  324.   defsubr (&Sdelete_backward_char);
  325.  
  326.   defsubr (&Sself_insert_command);
  327.   defsubr (&Snewline);
  328. }
  329.  
  330. keys_of_cmds ()
  331. {
  332.   int n;
  333.  
  334.   ndefkey (Vglobal_map, Ctl('M'), "newline");
  335.   ndefkey (Vglobal_map, Ctl('I'), "self-insert-command");
  336.   for (n = 040; n < 0177; n++)
  337.     ndefkey (Vglobal_map, n, "self-insert-command");
  338.  
  339.   ndefkey (Vglobal_map, Ctl ('A'), "beginning-of-line");
  340.   ndefkey (Vglobal_map, Ctl ('B'), "backward-char");
  341.   ndefkey (Vglobal_map, Ctl ('D'), "delete-char");
  342.   ndefkey (Vglobal_map, Ctl ('E'), "end-of-line");
  343.   ndefkey (Vglobal_map, Ctl ('F'), "forward-char");
  344.   ndefkey (Vglobal_map, 0177, "delete-backward-char");
  345. }
  346.